home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / sqlMode.tcl < prev    next >
Text File  |  1996-08-15  |  5KB  |  141 lines
  1.  
  2. #############################################################################
  3. #   FILE: sql.tcl
  4. #----------------------------------------------------------------------------
  5. # AUTHOR:     Joel D. Elkins
  6. #     of      New Media, Inc.
  7. #             200 South Meridian, Ste. 220
  8. #             Indianapolis, IN 46225
  9. #
  10. # internet:   jdelkins@iquest.net  (preferred)
  11. # compuserve: 72531,314
  12. # AOL:        jdelkins
  13. #
  14. #   Copyright © 1994-1995 by Joel D. Elkins
  15. #   All rights reserved.
  16. #############################################################################
  17. #
  18. #  Alpha mode for SQL and Oracle's PL/SQL programming language
  19. #  Converts SQL and PL/SQL keywords to uppercase on the fly and colorizes
  20. #
  21. #############################################################################
  22. # HISTORY
  23. #                  
  24. # modified who rev reason
  25. # -------- --- --- ------ 
  26. # 7/29/94  JDE 1.0 Original 
  27. # 2/8/95   JDE 1.1 Added electUpper for tab, cr, and ';'
  28. #############################################################################
  29.  
  30. if {$startingUp} {
  31.     #===============================================================================
  32.     # PL/SQL mode by Joel D. Elkins
  33.     addMode SQL dummySQL { *.sql *.SQL *.pkg} {}
  34.     return
  35. }
  36.  
  37.  
  38.  
  39.  
  40. proc dummySQL {} {}
  41.  
  42. #############################################################################
  43. # PL/SQL mode by Joel D. Elkins
  44. #############################################################################
  45. lappend modes SQL
  46. set modeMenus(SQL)                        { }
  47. set dummyProc(SQL)                        dummySQL
  48. newModeVar    SQL     elecRBrace            {0}    1
  49. newModeVar    SQL     electricSemi        {1}    1
  50. newModeVar    SQL        wordBreak            {(\$)?\w+} 0
  51. newModeVar    SQL        prefixString        {--} 0
  52. newModeVar    SQL        elecLBrace            {0} 1
  53. newModeVar    SQL        wordWrap            {0} 1
  54. newModeVar    SQL        funcExpr            {(PROCEDURE|FUNCTION)[ \t]+(\w+)} 0
  55. newModeVar    SQL        wordBreakPreface    {[^a-zA-Z0-9_\$]} 0
  56.  
  57. set sqlKeywords {
  58.     ABORT ACCEPT ACCESS ALTER AND ARRAY ARRAYLEN AS ASSERT AT AVG BEGIN BETWEEN BODY
  59.     CASE COLUMNS COMMIT CONSTANT COUNT CREATE CURSOR DECLARE DEFAULT DEFINITION
  60.     DELETE DESC DISPOSE DISTINCT DO DROP ELSE ELSIF END ENTRY EXCEPTION EXISTS EXIT
  61.     FALSE FETCH FOR FROM FUNCTION GOTO IF IN INSERT INTERSECT INTO IS LIKE LOOP MAX MIN
  62.     MINUS MOD NEW OF ON OPEN OR OUT PACKAGE PARTITION POSITIVE PRAGMA PRIVATE
  63.     PROCEDURE PUBLIC RANGE RECORD REM REPLACE RETURN ROLLBACK ROWTYPE RUN SAVEPOINT
  64.     SELECT SET SIZE START STDDEV SUM THEN TO TYPE UNION UNIQUE UPDATE USE VALUES
  65.     VARIANCE WHEN WHERE WHILE WITH XOR
  66. }
  67. ###    Just colorize uppercase keywords
  68. #    abort accept access alter and array arraylen as assert at avg begin between body
  69. #    case columns commit constant count create cursor declare default definition
  70. #    delete desc dispose distinct do drop else elsif end entry exception exists exit
  71. #    false fetch for from function goto if in insert intersect into is like loop max min
  72. #    minus mod new of on open or out package partition positive pragma private
  73. #    procedure public range record rem replace return rollback rowtype run savepoint
  74. #    select set size start stddev sum then to type union unique update use values
  75. #    variance when where while with xor
  76. ###
  77. regModeKeywords -e {--} -b {/*} {*/} -c red -k blue SQL $sqlKeywords
  78. unset sqlKeywords
  79. #================================================================================
  80.  
  81. catch {unset plSqlKeywords}
  82.  
  83. lappend plSqlKeywords \
  84.     abort accept access alter and array arraylen as assert at avg begin between body \
  85.     case columns commit constant count create cursor declare default definition \
  86.     delete desc dispose distinct do drop else elsif end entry exception exists exit \
  87.     false fetch for from function goto if in insert intersect into is like loop max min \
  88.     minus mod new of on open or out package partition positive pragma private \
  89.     procedure public range record rem replace return rollback rowtype run savepoint \
  90.     select set size start stddev sum then to type union unique update use values \
  91.     variance when where while with xor
  92.  
  93.  
  94. proc electUpper {char} {
  95.     global plSqlKeywords
  96.     
  97.     set a [getPos]
  98.     backwardWord
  99.     set b [getPos]
  100.     
  101.     #make sure we're not in a comment
  102.     beginningOfLine
  103.     set commentSearch {(^[ \t]*rem[ \t]+)|(^[ \t]*REM[ \t]+)|--}
  104.     if {[catch {search -r 1 -f 1 -l $b -- $commentSearch [getPos]}] != 0} {
  105.         #if not, make the word uppercase if it's a keyword
  106.         set cmd [getText $b $a]
  107.         goto $b
  108.         if {[lsearch -exact $plSqlKeywords $cmd] >= 0} {
  109.             upcaseWord
  110.         }
  111.     }
  112.     goto $a
  113.     if { 0 == [string compare $char "\r"] } {
  114.         carriageReturn
  115.     } else {
  116.         insertText $char
  117.     }
  118. }
  119.  
  120. bind '\ ' {electUpper "\ "} "SQL"
  121. bind '\t' {electUpper "\t"} "SQL"
  122. bind '\r' {electUpper "\r"} "SQL"
  123. bind '\;' {electUpper "\;"} "SQL"
  124.  
  125. proc SQLMarkFile {} {
  126.     global SQLmodeVars
  127.     set pos 0
  128.     while {![catch {search -f 1 -r 1 -m 0 -i 0 $SQLmodeVars(funcExpr) $pos} res]} {
  129.         set start [lindex $res 0]
  130.         set end [lindex $res 1]
  131.         set text [lindex [getText $start $end] 1]
  132.         set pos $end
  133.         set inds($text) "$start $end"
  134.     }
  135.     
  136.     if {[info exists inds]} {
  137.         foreach f [lsort [array names inds]] {
  138.             setNamedMark $f [lineStart [lineStart [lindex $inds($f) 0]] - 1] [lindex $inds($f) 0] [lindex $inds($f) 1]
  139.         }
  140.     }
  141. }